perm filename WAVE.F4[RST,LCS] blob
sn#153749 filedate 1975-07-17 generic text, type T, neo UTF8
00100 C****** WAVE.F4 ----- LOAD WITH NEWIO.FAI -------
00200 C CAN PROCESS UP TO 4.5 SECS. OF SOUND IN MUSIC.MUS
00300 DIMENSION K(15000),NJ(3)
00400 EQUIVALENCE (KA,NJ(1)),(KK,NJ(2)),(KM,NJ(3))
00500 DATA SRATE/10417./,I/5/
00700 TYPE 1
00800 JOUT=5
00850 X=1.
00900 CN=2.
01000 ACCEPT 2,XA
01010 TYPE 14
01020 14 FORMAT(' SKIP APPROX. HOW MANY SMPLS? '$)
01030 ACCEPT 2,FRST
01040 MF=FRST/3.
01100 TYPE 11
01200 ACCEPT 2,T
01250 IF(T.NE.0)GO TO 17
01300 TYPE 12
01400 ACCEPT 2,POS
01500 17 TYPE 13
01600 ACCEPT 2,STP
01610 IF(T.NE.0)GO TO 16
01710 TYPE 15
01720 15 FORMAT(' WAVE WIDTH IN INCHES-- '$)
01730 ACCEPT 2,YDIV
01740 YDIV=4096./YDIV
01750 IF(YDIV.EQ.0)YDIV=2000.
01770 16 FORMAT(' LENGTH FACTOR--1,2 OR 3-- '$)
01775 TYPE 16
01780 ACCEPT 2,X
01785 I=5
01787 IF(STP.NE.0)I=STP
01790 X=X/100.
01795 IF(X.EQ.0)X=.01
01800 18 M=XA
01900 L=M/3.
02000 C M=NUM OF SMPLS, L=NUM OF WDS.
02100 IF(T.NE.0)JOUT=T
02200 IF(T.NE.0)T=-1
02300 IF(POS.NE.0)CN=POS
02500 IF(T)YDIV=1.
02600
02700 1 FORMAT(' TYPE SMPLS '$)
02800 11 FORMAT(' 0=PLT, 5=TTY, 3=LPT '$)
02900 12 FORMAT(' INCHES FROM RT. ON PLTR. '$)
03000 13 FORMAT(' HOW MANY SMPLS PER PLT. POINT? '$)
03100 2 FORMAT(5F)
03200 XL=0
03300 NLL=0
03400 J='MUSIC'
03500 CALL GETFI2(J)
03510 IF(MF.NE.0)CALL FASTI2(K,MF)
03520 C SKIPS OVER MF WORDS.
03600 CALL FASTI2(K,L)
03700 IF(T)GO TO 3
03800 CALL PLOTS(N)
03900 CALL PLOT(0.,CN,-3)
04000 3 DO 4 N=1,L
04100 CALL UNPACK(K(N),KA,KK,KM)
04200 C UNPACKS 12 BIT SMPLS
04300 DO 4 NN=1,3
04400 NLL=NLL+1
04500 IF(MOD(NLL,I).NE.0)GO TO 4
04600 KL=NJ(NN)
04700 IF(KL.GT.2047)KL=KL-4095
04800 AX=KL/YDIV
04900 XL=XL+X
05000 IF(T)GO TO 5
05100 CALL PLOT(XL,AX,2)
05200 GO TO 4
05300 5 WRITE(JOUT, 10)XL,AX
05400 IF(ABS(AX).GT.1000.)PAUSE
05500 4 CONTINUE
05600 IF(T)CALL EXIT
05700 CALL PLOT(0.,0.,3)
05800 10 FORMAT(2F10.4)
05900 END